00100	(DEFPROP TRACE
00200	 (LAMBDA (%%L)
00300	  (MAPCAR
00400	   (FUNCTION (LAMBDA (%%FN)
00500		      (PROG (%%IND %%T1 %%G1 %%G2)
00600			    (COND ((NOT	(AND (SETQ %%T1
00700					      (GETL %%FN
00800						    (QUOTE (EXPR SUBR
00900								 FEXPR
01000								 FSUBR))))
01100					     (NOT (GET %%FN
01200						       (QUOTE %%TRACE)))))
01300				   (RETURN NIL)))
01400			    (PUTPROP %%FN
01500				     (CONS (SETQ %%G1 (INTERN (GENSYM)))
01600					   (SETQ %%G2 (INTERN (GENSYM))))
01700				     (QUOTE %%TRACE))
01800			    (SET %%G1 0)
01900			    (PUTPROP (QUOTE %%TRACE)
02000				     (CONS %%G1
02100					   (GET	(QUOTE %%TRACE)
02200						(QUOTE %%CNTRS)))
02300				     (QUOTE %%CNTRS))
02400			    (PUTPROP %%G2
02500				     (CADR %%T1)
02600				     (SETQ %%IND (CAR %%T1)))
02700			    (PUTPROP %%FN
02800				     (LIST (QUOTE LAMBDA)
02900					   (QUOTE (%%L%%))
03000					   (LIST (QUOTE %%TRACE1)
03100						 (LIST (QUOTE QUOTE) %%FN)
03200						 (QUOTE %%L%%)
03300						 (LIST (QUOTE QUOTE) %%G1)
03400						 (LIST (QUOTE QUOTE) %%G2)
03500						 (OR (EQ %%IND (QUOTE FEXPR))
03600						     (EQ %%IND
03700							 (QUOTE FSUBR)))))
03800				     (QUOTE FEXPR))
03900			    (OR	(EQ %%IND (QUOTE FEXPR))
04000				(REMPROP %%FN %%IND))
04100			    (RETURN %%FN))))
04200	   %%L))
04300	 FEXPR)
04400	
     

00100	(DEFPROP %%TRACE1
00200	 (LAMBDA (%%NAM %%ARGS %%CNTR %%FUN %%F)
00300	  (PROG (%%V)
00400		(PRINT (LIST (QUOTE ENTERING)
00500			     (SET %%CNTR (ADD1 (EVAL %%CNTR)))
00600			     %%NAM))
00700		(OR %%F (SETQ %%ARGS (EVAL (CONS (QUOTE LIST) %%ARGS))))
00800		(COND ((EQUAL (CHRCT) (LINELENGTH NIL)) (TERPRI NIL)))
00900		(TERPRI (PRIN1 (CONS %%NAM %%ARGS)))
01000		(SETQ %%V (COND	(%%F (EVAL (CONS %%FUN %%ARGS)))
01100				(T (APPLY (QUOTE %%FUN) %%ARGS))))
01200		(PRINT (LIST (QUOTE LEAVING)
01300			     (ADD1 (SET %%CNTR (SUB1 (EVAL %%CNTR))))
01400			     %%NAM))
01500		(RETURN (TERPRI (PRIN1 (%%VAL (QUOTE %%V)))))))
01600	 EXPR)
01700	
01800	(DEFPROP %%VAL (LAMBDA (%%T1) (CDR (GET %%T1 (QUOTE VALUE)))) EXPR)
01900	
02000	(DEFPROP UNTRACE
02100	 (LAMBDA (%%L)
02200	  (MAPCAR (FUNCTION (LAMBDA (%%FN)
02300			     (PROG (%%IND %%T1 %%T2)
02400				   (COND ((NOT (SETQ %%T2
02500						     (GET %%FN
02600							  (QUOTE %%TRACE))))
02700					  (RETURN NIL)))
02800				   (SETQ %%T1 (GETL (CDR %%T2)
02900						    (QUOTE (EXPR SUBR
03000								 FEXPR
03100								 FSUBR))))
03200				   (PUTPROP %%FN
03300					    (CADR %%T1)
03400					    (SETQ %%IND (CAR %%T1)))
03500				   (EVAL (LIST (QUOTE REMOB)
03600					       (CAR %%T2)
03700					       (CDR %%T2)))
03800				   (REMPROP %%FN (QUOTE %%TRACE))
03900				   (OR (EQUAL %%IND (QUOTE FEXPR))
04000				       (REMPROP %%FN (QUOTE FEXPR)))
04100				   (RETURN %%FN))))
04200		  %%L))
04300	 FEXPR)
04400	
     

00100	(DEFPROP TRACET
00200	 (LAMBDA NIL
00300	  (PROG NIL
00400		(PUTPROP (QUOTE %%SETQ)
00500			 (GET (QUOTE SETQ) (QUOTE FSUBR))
00600			 (QUOTE FSUBR))
00700		(PUTPROP (QUOTE %%SET)
00800			 (GET (QUOTE SET) (QUOTE SUBR))
00900			 (QUOTE SUBR))
01000		(DEFPROP SETQ
01100		 (LAMBDA (%%X1%%)
01200		  (PROG (%%V1%%)
01300			(%%SETQ %%V1%% (EVAL (CONS (QUOTE %%SETQ) %%X1%%)))
01400			(COND ((NOT (GET (CAR %%X1%%) (QUOTE %%TRACET)))
01500			       (RETURN (%%VAL (QUOTE %%V1%%)))))
01600			(TERPRI	(PRINT (LIST (QUOTE SETQ)
01700					     (CAR %%X1%%)
01800					     (%%VAL (QUOTE %%V1%%)))))
01900			(RETURN (%%VAL (QUOTE %%V1%%)))))
02000		 FEXPR)
02100		(DEFPROP SET
02200		 (LAMBDA (%%X2%% %%V2%%)
02300			 (PROG NIL
02400			       (%%SET %%X2%% (%%VAL (QUOTE %%V2%%)))
02500			       (COND ((NOT (GET %%X2%% (QUOTE %%TRACET)))
02600				      (RETURN (%%VAL (QUOTE %%V2%%)))))
02700			       (TERPRI (PRINT (LIST (QUOTE SET)
02800						    %%X2%%
02900						    (%%VAL (QUOTE %%V2%%)))))
03000			       (RETURN (%%VAL (QUOTE %%V2%%)))))
03100		 EXPR)))
03200	 EXPR)
03300	
03400	(DEFPROP UNTRACET
03500		 (LAMBDA NIL
03600			 (PROG NIL
03700			       (REMPROP (QUOTE SETQ) (QUOTE FEXPR))
03800			       (REMPROP (QUOTE SET) (QUOTE EXPR))))
03900		 EXPR)
04000	
04100	(DEFPROP SLST
04200	 (LAMBDA (%%L)
04300	  (MAPCAR (FUNCTION (LAMBDA (%%X) (PUTPROP %%X T (QUOTE %%TRACET))))
04400		  %%L))
04500	 FEXPR)
04600	
04700	(DEFPROP UNSLST
04800	 (LAMBDA (%%L)
04900	  (MAPCAR (FUNCTION (LAMBDA (%%X) (REMPROP %%X (QUOTE %%TRACET))))
05000		  %%L))
05100	 FEXPR)
05200	
     

00100	(DEFPROP RESET
00200		 (LAMBDA NIL
00300			 (MAPCAR (FUNCTION (LAMBDA (%%CNTR) (SET %%CNTR 0)))
00400				 (GET (QUOTE %%TRACE) (QUOTE %%CNTRS))))
00500		 EXPR)
00600	
00700	(MAPC (FUNCTION (LAMBDA (X) (REMPROP X (QUOTE MACRO))))
00800	      (QUOTE (TRACE UNTRACE TRACET UNTRACET SLST UNSLST RESET)))
00900